home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / Pocket Forth rel.5 / Text files / Graphics < prev    next >
Encoding:
Text File  |  1991-07-20  |  4.1 KB  |  92 lines  |  [TEXT/EDIT]
  1. ( Grafics )
  2.  
  3. ( create named rects )
  4. : RECT ( compile: -- ) ( run: -- addr ) variable 6 allot ;
  5.  
  6. ( rect words work on any 8 bytes )
  7. : !RECT ( t l b r rect -- ) >r  swap r 4 + 2!  swap r> 2! ;
  8. : @RECT ( rect -- t l b r ) dup 2@ swap  rot 4 + 2@ swap ;
  9. : @TL ( rect -- t l ) @rect 2drop ;
  10. : RCENTER ( rect -- h v ) @rect >r swap >r  ( -- tb r: -- rl )
  11.     over - 2 / +  2r>  dup rot swap - 2 / + swap ;
  12. : RCLIP ( rect -- ) a>r ,$ A87B ; ( _ClipRect )
  13. : RINVALID ( rect -- ) a>r ,$ A928 ;  ( _InvalRect )
  14. : ROFFSET ( h v rect -- ) a>r 2>r ,$ A8A8 ;  ( _OffsetRect )
  15. : RINSET ( h v rect -- ) a>r 2>r ,$ A8A9 ;  ( _InsetRect ) ( fixed)
  16. : ?IN ( h v rect -- flag ) ( true if h,v is in rect at addr )
  17.     0 >r  rot rot 2>r  a>r  ,$ A8AD r> ;  ( _PtInRect )
  18. : ?EMPTY ( rect -- flag ) 0 >r a>r ,$ A8AE r> ;  ( _EmptyRect )
  19.  
  20. ( rect drawing )
  21. : RFRAME ( rect -- ) a>r ,$ A8A1 ;  ( _FrameRect )
  22. : OFRAME ( rect -- ) a>r ,$ A8B7 ;  ( _FrameOval )
  23. : RERASE ( rect -- ) a>r ,$ A8A3 ;  ( _EraseRect )
  24. : OERASE ( rect -- ) a>r ,$ A8B9 ;  ( _EraseOval )
  25. : RINVERT ( rect -- ) a>r ,$ A8A4 ;  ( _InvertRect )
  26. : OINVERT ( rect -- ) a>r ,$ A8BA ;  ( _InvertOval )
  27.  
  28. ( Read PICT resources from a file on disk ) ( If the pictures ... )
  29. (  ... are in the current file, only getpict need be called. )
  30. variable #REF  ( resource file reference number )
  31. : ROPEN ( addr -- ) ( rel addr of the file/path name )
  32.     0 >r  a>r ,$ A997 r> #ref ! ;  ( _OpenResFile )
  33. : RCLOSE ( -- ) ( always close after each opening )
  34.     #ref @ >r ,$ A99A  0 #ref ! ;  ( _CloseResFile )
  35. : GETPICT ( id -- dhandle ) 0 0 2>r  >r  ,$ A9BC  2r> ;  ( _GetPict )
  36.  
  37. ( create pictures )
  38. : PICTURE ( rect -- dhandle ) ( start a picture definition )
  39.     0 0 2>r  a>r  ,$ A8F3 2r> ;  ( _OpenPicture )
  40. : PCLOSE ,$ A8F4 ; macro  ( _ClosePicture )
  41. : PKILL ( addr -- ) 2@ 2>r ,$ A8F5 ; ( _KillPicture at addr )
  42.  
  43. ( display pictures )
  44. : PRECT ( dhandle -- t l b r ) ( the Picture RECT )
  45.     dl@ 2dup  2 0 d+ dl@  2swap  6 0 d+ dl@ ;
  46. : PSIZE ( dhandle -- h v ) prect rot - abs  rot rot - abs ;
  47. : DPICT ( dhandle h v -- ) ( draw a picture in its own rect )
  48.     2over psize 2over d+  here !rect
  49.     2>r  here a>r ,$ A8F6 ;  ( _DrawPicture )
  50. : PDRAW ( rect dhandle -- ) ( draw a picture in a rect )
  51.     2>r a>r ,$ A8F6 ;  ( _DrawPicture )
  52.  
  53. ( regions ) ( keep the handle on the stack "dhandle" )
  54. : REGION ( -- dhandle ) ( create an open region, deliver a handle )
  55.     0 0 2>r ,$ A8D8 2r>  ,$ A8DA ;  ( _NewRgn  _OpenRgn )
  56. : RGCLOSE ( dhandle -- ) 2>r ,$ A8DB ; macro  ( _CloseRgn )
  57. : RGDISP ( dhandle -- ) 2>r ,$ A8D9 ; macro  ( _DisposRgn )
  58. : RGCLIP ( dhandle -- ) 2>r ,$ A879 ; macro  ( _SetClip )
  59. : ?RGIN ( dhandle h v -- flag ) ( true if h,v is in region at dhandle )
  60.     0 >r 2>r 2>r ,$ A8E8 r> ;  ( _PtInRegion )
  61.  
  62. ( region drawing )
  63. : RGFRAME ( dhandle -- ) 2>r ,$ A8D2 ; macro  ( _FrameRgn )
  64. : RGERASE ( dhandle -- ) 2>r ,$ A8D4 ; macro  ( _EraseRgn )
  65. : RGINVERT ( dhandle -- ) 2>r ,$ A8D5 ; macro  ( _InvertRgn )
  66.  
  67. ( font words )
  68. : !FONT ( n -- ) >r ,$ A887 ; macro  ( _TextFont ) ( set font )
  69. : !FSIZE ( n -- ) >r ,$ A88A ; macro  ( _TextSize ) ( set size )
  70. : !FACE ( face -- ) >r ,$ A888 ; macro ( _TextFace ) ( set style )
  71. : SFONT ( -- ) 0 !font  12 !fsize ;  ( set System font )
  72. : NFONT ( -- ) 4 !font  09 !fsize ;  ( set Normal font )
  73.  
  74. ( Polygons ) ( keep the handle in a 2variable "poly" )
  75. : NPOLY ( poly -- ) 0 0 2>r ,$ A8CB 2r> rot 2! ;  ( _OpenPoly )
  76. : CPOLY ( -- ) ,$ A8CC ; macro  ( _ClosePgon )
  77. : FPOLY ( poly -- ) 2@ 2>r ,$ A8C6 ;  ( _FramePoly )
  78. : EPOLY ( poly -- ) 2@ 2>r ,$ A8C8 ;  ( _ErasePoly )
  79. : KPOLY ( poly -- ) 2@ 2>r ,$ A8CD ;  ( _KillPoly )
  80. : ?PHIT ( h v poly -- flag ) ( true if h,v is in polyBBox )
  81.     0 >r  2@ dl@  2 0 d+  2swap 2>r  2>r ,$ A8AD r> ;  ( _PtInRect )
  82.  
  83. ( old style colors )
  84. : BLACK    33 0 2>r ,$ A862 ;  ( black _ForeColor )
  85. : WHITE    30 0 2>r ,$ A862 ;  ( white _ForeColor )
  86. : RED     205 0 2>r ,$ A862 ;  ( red _ForeColor )
  87. : GREEN   341 0 2>r ,$ A862 ;  ( green _ForeColor )
  88. : BLUE    409 0 2>r ,$ A862 ;  ( blue _ForeColor )
  89. : CYAN    273 0 2>r ,$ A862 ;  ( blue-green _ForeColor )
  90. : MAGENTA 137 0 2>r ,$ A862 ;  ( purple _ForeColor )
  91. : YELLOW   69 0 2>r ,$ A862 ;  ( yellow _ForeColor )
  92.